Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/datamgr/faddindx.frm

Visual Basic Form | 1995-10-23 | 7.6 KB | 264 lines

VERSION 2.00
Begin Form fAddIndex
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Add Index"
   ClientHeight    =   3930
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   7350
   Height          =   4335
   Left            =   1035
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3930
   ScaleWidth      =   7350
   Top             =   1140
   Visible         =   0   'False
   Width           =   7470
   Begin CommandButton cCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   6000
      TabIndex        =   10
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton cDone
      Caption         =   "&Done"
      Height          =   375
      Left            =   6000
      TabIndex        =   9
      Top             =   240
      Width           =   1095
   End
   Begin CommandButton cRemove
      Caption         =   "&Remove"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2520
      TabIndex        =   4
      Top             =   2400
      Width           =   1095
   End
   Begin CommandButton cAdd
      Caption         =   "Add (D&ec)"
      Enabled         =   0   'False
      Height          =   375
      Index           =   1
      Left            =   2520
      TabIndex        =   3
      Top             =   1920
      Width           =   1095
   End
   Begin CommandButton cAdd
      Caption         =   "&Add (Asc)"
      Enabled         =   0   'False
      Height          =   375
      Index           =   0
      Left            =   2520
      TabIndex        =   2
      Top             =   1440
      Width           =   1095
   End
   Begin TextBox cIndexName
      Height          =   285
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   2055
   End
   Begin CheckBox cPrimary
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Primary Index"
      Height          =   255
      Left            =   3840
      TabIndex        =   8
      Top             =   3600
      Width           =   1695
   End
   Begin CheckBox cUnique
      BackColor       =   &H00C0C0C0&
      Caption         =   "Require &Unique Index Values"
      Height          =   255
      Left            =   480
      TabIndex        =   7
      Top             =   3600
      Width           =   2895
   End
   Begin ListBox cFields
      Height          =   2370
      Left            =   3720
      TabIndex        =   6
      Top             =   960
      Width           =   2040
   End
   Begin ListBox cFieldList
      Height          =   2370
      Left            =   360
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   975
      Width           =   2040
   End
   Begin Label cTableName
      Caption         =   "cTableName"
      Height          =   255
      Left            =   4320
      TabIndex        =   5
      Top             =   3960
      Visible         =   0   'False
      Width           =   2535
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Index Name:"
      Height          =   255
      Left            =   360
      TabIndex        =   13
      Top             =   120
      Width           =   2055
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Field&s in Index"
      Height          =   255
      Left            =   3720
      TabIndex        =   12
      Top             =   720
      Width           =   1815
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Fields in Table"
      Height          =   255
      Left            =   360
      TabIndex        =   11
      Top             =   720
      Width           =   1935
   End
Sub cAdd_Click (Index As Integer)
    Dim PlMn As String
    PlMn = "+"
    If Index = 1 Then PlMn = "-"
    cFields.AddItem PlMn & cFieldList.List(cFieldList.ListIndex)
    cFieldList.RemoveItem cFieldList.ListIndex
    cFieldList.ListIndex = -1
    For I = 0 To 1
        cAdd(I).Enabled = False
    Next I
    If cFields.ListCount > 0 And cIndexName <> "" Then
        cDone.Enabled = True
        cDone.Default = True
    End If
    cFieldList.SetFocus
End Sub
Sub cCancel_Click ()
'Close Dialog
Unload fAddIndex
End Sub
Sub cDone_Click ()
    Dim idx As New Index
    Dim tempFields As String
    Dim temp As String
    Dim I As Integer
    Dim AddErr As Integer
    On Error Resume Next
    'Set up index properties
    idx.Name = cIndexName
    idx.Primary = -cPrimary
    idx.Unique = -cUnique
    tempFields = ""
    For I = 0 To cFields.ListCount - 1
        temp = cFields.List(I)
        temp = Left$(temp, 1) & "[" & Right$(temp, Len(temp) - 1) & "]"
        tempFields = tempFields + temp + ";"
    Next I
    If Len(tempFields) > 255 Then
        MsgBox "Too many fields in Index.  Remove some and try again.", 64, "Data Manager"
    Else
        'Remove the last semicolon
        idx.Fields = Left$(tempFields, Len(tempFields) - 1)

        'Append to the Index Collection
        gDatabase.TableDefs(cTableName).Indexes.Append idx
        AddErr = Err
        If AddErr <> 0 Then
            MsgBox "Error Adding Index: " + Chr$(13) + Error$, 64, "Data Manager"
        End If
        If AddErr = 3283 Then 'Primary Key already exists
            'cPrimary = 0
        ElseIf AddErr = 3277 Then 'Too many fields in list
            cFields.ListIndex = 0
        Else
            'Close Dialog
            Unload fAddIndex
        End If
    End If
End Sub
Sub cFieldList_Click ()
    If cFieldList.ListIndex <> -1 Then
        cAdd(0).Enabled = True
        cAdd(1).Enabled = True
        cRemove.Enabled = False
        cFields.ListIndex = -1
        cAdd(0).Default = True
    End If
End Sub
Sub cFieldList_DblClick ()
    'Add the item
    cAdd_Click (0)
End Sub
Sub cFields_Click ()
    If cFields.ListIndex <> -1 Then
        cFieldList.ListIndex = -1
        cRemove.Enabled = True
        cAdd(0).Enabled = False
        cAdd(1).Enabled = False
    End If
End Sub
Sub cFields_DblClick ()
    'Remove the item
    cRemove_Click
End Sub
Sub cIndexName_Change ()
    If cFields.ListCount > 0 And cIndexName <> "" Then
        cDone.Enabled = True
        cDone.Default = True
    Else
        cDone.Enabled = False
    End If
End Sub
Sub cRemove_Click ()
    Dim temp As String
    temp = cFields.List(cFields.ListIndex)
    cFields.RemoveItem cFields.ListIndex
    cFieldList.AddItem Right$(temp, Len(temp) - 1)
    If cFields.ListCount <= 0 Then
        cDone.Enabled = False
    End If
    cFieldList.ListIndex = 0
    cFieldList.SetFocus
End Sub
Sub Form_Activate ()
    Dim I As Integer
    Dim TD As Tabledef
    Dim FieldCount As Integer
    On Error Resume Next
    Screen.MousePointer = 11
    Set TD = gDatabase.TableDefs(cTableName.Caption)
    FieldCount = TD.Fields.Count
    If FieldCount > 0 Then 'it should be
        For I = 0 To FieldCount - 1
            If TD.Fields(I).Type <= 10 Then  'not ole or memo
                cFieldList.AddItem TD.Fields(I).Name
            End If
        Next I
    End If
    Screen.MousePointer = 0
    'enable buttons
    cDone.Enabled = False
End Sub